R Notebook

library(readxl)
library(tidyverse)

Despesas por função (aqui!)

#library(extrafont)
#font_import()
#loadfonts()
tres_cores <-c("#F8AC08","#028063","#1E466A")
tres_cores_pasteis <- c("#FECE60","#63BEAF", "#7A9CBD")
tema_BSPN <- function(){
    theme_minimal() +
    theme(
      text = element_text(family = "Source Sans Pro", colour = "grey20"),
      axis.text = element_text(family = "Source Sans Pro", colour = "grey20"),
      title = element_text(face = "bold"),
      plot.subtitle = element_text(face = "plain"),
      panel.grid.major = element_blank(), 
      panel.grid.minor = element_blank(),
      legend.text = element_text(size = 8),
      legend.title = element_text(size = 8),
      legend.position = 'bottom')
}
desp_fun <- read_excel("funcao_2017.xlsx")
tabela_nomes_funcoes <- desp_fun[1:28,1:2]
desp_fun$pctU2017 <- 100*desp_fun$`UNIÃO_2017` / rowSums(desp_fun[,c(3,5,7)])
desp_fun$pctU2016 <- 100*desp_fun$`UNIÃO_2016` / rowSums(desp_fun[,c(4,6,8)])
desp_fun <- desp_fun[,c(1,2,9,10,3:8)]
d_fun <- desp_fun[c(1:28,31),] %>%
  gather(-1:-4, key="Ente_Ano", value="valor") %>%
  separate(Ente_Ano, into = c("Ente", "Ano")) # por padrão ele separa por qq caractere não-alfanumérico, 
                                              # ou se usaria um {,sep = "_"}
# uma tabelinha com totais e uma versão do dataframe com esses totais para ordenar o gráfico de vlrs absolutos
tot_fun_2017 <- d_fun %>%
  group_by(Funcao, Ano) %>%
  summarise(soma_funcao = sum(valor))
d_fun_tot <- d_fun %>%
  left_join(tot_fun_2017)

Joining, by = c("Funcao", "Ano")

# uma outra tabelinha para comparar previdencia e encargos especiais com as demais funcoes
d_fun_demais <- d_fun %>%
  filter(Ano=="2017" & !is.na(Funcao) & !(Funcao %in% c("28 - Encargos Especiais", "09 - Previdência Social"))) %>%
  group_by(Ente,Ano) %>%
  summarise(valor = sum(valor)) %>%
  mutate(Funcao = "Demais funções")
d_fun_prevEnc <- d_fun %>% 
  filter(Ano=="2017" & !is.na(Funcao) & (Funcao %in% c("28 - Encargos Especiais", "09 - Previdência Social"))) %>%
  select(Ente, Ano, valor, Funcao)
d_fun_principais <- d_fun_prevEnc %>%
  bind_rows(d_fun_demais) %>%
  mutate (Funcao = factor(Funcao))
# os gráficos
plot_fun_dark <- ggplot(d_fun %>% filter(Ano=="2017" & !is.na(Funcao)), aes(fill=Ente, y=valor, x=Funcao)) +
    coord_flip() +
    geom_bar( stat="identity", position="fill", width=0.6, color = "grey20", size = 1) +
    labs(
      x = NULL,
      y = NULL,
      fill = "Ente",
      title = "Distribuição das despesas por ente da Federação",
      subtitle = "Conforme a classificação funcional"
    ) +
    scale_y_continuous(labels = scales::percent) +
    scale_fill_manual(values = c("#8D993D","#406AFF","#FFD500")) +
    theme_minimal() +
    theme(
      plot.background = element_rect(fill = "grey20"),
      text = element_text(family = "Source Sans Pro", colour = "white"),
      axis.text = element_text(family = "Source Sans Pro", colour = "white"),
      title = element_text(face = "bold"),
      plot.subtitle = element_text(face = "plain"),
      panel.grid.major = element_blank(), 
      panel.grid.minor = element_blank(),
      legend.text = element_text(size = 8),
      legend.title = element_text(size = 8),
      legend.position = 'bottom')
# fct_reorder muito útil! só que tenho q colocar em ordem descendente de PERCENTUAL, e não de valor. preciso
# criar essa variável.
plot_fun <- ggplot(
      d_fun %>% filter(Ano=="2017" & !is.na(Funcao)), 
      aes(
        fill = factor(Ente, levels = rev(c("UNIÃO", "ESTADOS", "MUNICÍPIOS"))), 
        y = valor, 
        x = fct_reorder(Funcao,pctU2017,desc=TRUE))) +
    coord_flip() +
    geom_bar( stat="identity", position="fill", width=0.6, color = "white", size = 1) +
    labs(
      x = NULL,
      y = NULL,
      fill = "Ente",
      title = paste("Distribuição das despesas por ente da Federação ","\u2013"," 2017"),
      subtitle = "Conforme a Classificação Funcional. Por ordem decrescente da participação da União no total da despesa."
    ) +
    scale_y_continuous(labels = scales::percent) +
    scale_fill_manual(values = tres_cores) +
    tema_BSPN()
#reais <- scales::dollar_format(prefix = "R$ ", suffix = " bilhões", largest_with_cents = 1000, big.mark=".", decimal.mark=",")
#reais(10000)
plot_fun_abs <- ggplot(
      d_fun_tot %>% filter(Ano=="2017" & !is.na(Funcao) & !(Funcao %in% c("28 - Encargos Especiais", "09 - Previdência Social"))), 
      aes(
        fill = factor(Ente, levels = rev(c("UNIÃO", "ESTADOS", "MUNICÍPIOS"))), 
        y = valor/1000, 
        x = fct_reorder(Funcao,soma_funcao,desc=TRUE))) +
    coord_flip() +
    geom_bar( stat="identity", width=0.6, color = "white", size = 1) +
    labs(
      x = NULL,
      y = NULL,
      fill = "Ente",
      title = paste("Despesas totais por Função ","\u2013"," 2017"),
      subtitle = "Em bilhões de reais. Exceto funções \"28 - Encargos Especiais\" e \"09 - Previdência Social\"."
    ) +
    #scale_y_discrete(breaks = c(0,100,200,300), labels = c("0","100","200","300")) +
    #scale_y_continuous(limits = c(0,max(subset(d_fun_tot, d_fun_tot$Ano == "2017")$soma_funcao)/1000)) +
    scale_y_continuous() + #uexpand = c(0,0) para zerar o padding entre o exito e o início do gráfico 
    scale_fill_manual(values = tres_cores) +
    tema_BSPN()
formata_BR <- scales::format_format(big.mark = ".", decimal.mark = ",", scientific = FALSE)
plot_fun_abs_principais <- ggplot(
      d_fun_principais, 
      aes(
        fill = factor(Ente, levels = rev(c("UNIÃO", "ESTADOS", "MUNICÍPIOS"))), 
        y = valor/1000, 
        x = fct_rev(Funcao))) +
    coord_flip() +
    geom_bar( stat="identity", width=0.6, color = "white", size = 1) +
    labs(
      x = NULL,
      y = NULL,
      fill = "Ente",
      title = paste("Despesas totais por Função ","\u2013"," 2017"),
      subtitle = "Em bilhões de reais."
    ) +
    #scale_y_discrete(breaks = c(0,100,200,300), labels = c("0","100","200","300")) +
    #scale_y_continuous(limits = c(0,max(subset(d_fun_tot, d_fun_tot$Ano == "2017")$soma_funcao)/1000)) +
    scale_y_continuous(labels = formata_BR) + #uexpand = c(0,0) para zerar o padding entre o exito e o início do gráfico 
    scale_fill_manual(values = tres_cores) +
    tema_BSPN()
plot_fun

plot_fun_abs_principais

plot_fun_abs

pibs <- c(pibs, 6559940)
for (i in 1:length(pibs)){
  sh_fun[,i+4] <- round(sh_fun[,i+4] / pibs[i], 4)
}
# passando para um formato tidy
sh_fun <- sh_fun %>%
  gather(5:20, key="Ano", value="Valor")
# funcoes para plotar os gráficos de barra
plot_funcoes <- function(funcao){
  ggplot(
      sh_fun %>% filter(Funcao_Maius==funcao & ente != "Consolidado"), 
      aes(
        fill = factor(ente, levels = rev(c("União", "Estados", "Municípios"))), 
        y = Valor, 
        x = Ano)) +
    #coord_flip() +
    geom_bar(stat = "identity", width=0.7, color = "white", size = 1) + #position = "fill"
    #geom_area(aes(group = ente),stat = "identity", position = "stack", color = "white") + #position = "fill"
    labs(
      x = NULL,
      y = NULL,
      fill = "Ente",
      title = paste("Distribuição das despesas com ", tolower(funcao), " por ente da Federação ","2002\u2013","2017", sep=""),
      subtitle = "Em percentuais do PIB."
    ) +
    scale_y_continuous(labels = scales::percent) +
    scale_fill_manual(values = tres_cores) +
    geom_text(aes(label= scales::percent(Valor)),size = 3, position = position_stack(vjust = 0.5), hjust = 0.5, family = "Source Sans Pro", color = "white") +
    tema_BSPN()
}
funcoes_de_interesse <- c("EDUCAÇÃO", "SAÚDE", "ASSISTÊNCIA SOCIAL", "SEGURANÇA PÚBLICA")
lapply(funcoes_de_interesse, plot_funcoes)

[[1]]

[[2]]

[[3]]

[[4]]

# plot_funcoes("EDUCAÇÃO")
# plot_funcoes("SAÚDE")
# plot_funcoes("ASSISTÊNCIA SOCIAL")
# plot_funcoes("SEGURANÇA PÚBLICA")
#ggplot(serie_f %>% filter(Funcao=="EDUCAÇÃO"), aes(x = Ano, y = Valor)) +
  #geom_point(aes(color=ente))+
  #geom_line(aes(group=ente))
  #geom_area(aes(fill = ente, group = ente), stat = "identity", position="stack")

Todas as funções

O balanço patrimonial

Os ativos

library(plotly)
# le os dados
ativo <- read.csv2("links-ativo.csv")
ativo$valor <- as.numeric(gsub("[.]", "", ativo$valor))
passivo <- read.csv2("links-passivo.csv")
passivo$valor <- as.numeric(gsub("[.]", "", passivo$valor))
# cores
mtx_tres_cores <- col2rgb(tres_cores_pasteis)
cores <- NULL
for (i in 1:dim(mtx_tres_cores)[2] ) {
  cores <- c(cores, paste("rgba(", mtx_tres_cores[1,i],", ",  mtx_tres_cores[2,i],", ",  mtx_tres_cores[3,i],", 0.7)", sep = ""))
}
tbl_cores <- data.frame("ente" = levels(ativo$ente),cores)
# funcao de plotagem
plota_sankey <- function(dados, rotulos, cor_nos){
  plot_ly(
    type = "sankey",
    orientation = "h",
    opacity = 0.6,
    width = 800,
    height = 600,
    textfont = list(
      family = "Source Sans Pro",
      color = "#444444",
      size = 12),
    
    node = list(
      label = rotulos,
      color = cor_nos, ##004a93
      pad = 10,
      thickness = 25,
      line = list(
        color = cor_nos,
        width = 0)),
    
    hoverlabel = list(
      font = list(
        family = "Source Sans Pro")),
    
    link = list(
      source = dados$src,
      target = dados$trg,
      value =  dados$valor,
      color =  dados$cores)) %>% 
  
    layout(
      title = "",
      font = list(
        family = "Source Sans Pro",
        size = 11,
        color = "#004a93"))
}
# funcao para processar os dados e chamar a função de plotagem
##### incluir argumento na função para cor dos nós!
plota_ente <- function(ente_in, dados, cor_nos){
  
  if (ente_in == "Consolidado") {
    dados_ente <- dados}
    else {dado_ente <- dados %>% filter(ente == ente_in)
  }
  
  lista_nos <- unique(c(levels(dados_ente$up), levels(dados_ente$down)))
  numeros_nos <- 0:(length(lista_nos)-1)
  nos <- data.frame(lista_nos, numeros_nos)
  
  matriz <- dados_ente %>%
    left_join(nos, by = c("up" = "lista_nos")) %>%
    rename(src = numeros_nos) %>%
    left_join(nos, by = c("down" = "lista_nos")) %>%
    rename(trg = numeros_nos)
  
  matriz <- matriz %>%
    left_join(tbl_cores)
  
  plota_sankey(matriz, lista_nos, cor_nos)
  #return(matriz)
}
#dados_consolidado <- gera_dados_ente("Consolidado")
#dados_Uniao <- gera_dados_ente("União")
#dados_Estados <- gera_dados_ente("Estados")
#dados_Municipios <- gera_dados_ente("Municípios")
plota_ente("Consolidado", ativo, "#170dce")

Column `up`/`lista_nos` joining factors with different levels, coercing to character vectorColumn `down`/`lista_nos` joining factors with different levels, coercing to character vectorJoining, by = "ente"

plota_ente("Consolidado", passivo, "#ce0e0e")

Column `up`/`lista_nos` joining factors with different levels, coercing to character vectorColumn `down`/`lista_nos` joining factors with different levels, coercing to character vectorJoining, by = "ente"

Diagrama Consolidado